home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / LabWidg.tcl.z / LabWidg.tcl
Encoding:
Text File  |  1999-01-26  |  3.7 KB  |  153 lines
  1. # LabWidg.tcl --
  2. #
  3. #    TixLabelWidget: Virtual base class. Do not instantiate
  4. #
  5. #     This widget class is the base class for all widgets that has a
  6. #     label. Most Tix compound widgets will have a label so that
  7. #     the app programmer doesn't need to add labels themselvel.
  8. #
  9. #
  10. # Copyright (c) 1996, Expert Interface Technologies
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. # LabelSide : top, left, right, bottom, none, acrosstop
  17. #
  18. # public widgets:
  19. #    frame, label
  20. #
  21.  
  22. tixWidgetClass tixLabelWidget {
  23.     -superclass tixPrimitive
  24.     -classname  TixLabelWidget
  25.     -flag {
  26.     -label -labelside -padx -pady
  27.     }
  28.     -static {-labelside}
  29.     -configspec {
  30.     {-label label Label ""}
  31.     {-labelside labelSide LabelSide left}
  32.     {-padx padX Pad 0}
  33.     {-pady padY Pad 0}
  34.     }
  35. }
  36.  
  37. proc tixLabelWidget:ConstructWidget {w} {
  38.     upvar #0 $w data
  39.  
  40.     tixChainMethod $w ConstructWidget
  41.  
  42.     if {$data(-labelside) != "acrosstop"} {
  43.     set data(w:frame) [frame $w.frame]
  44.     } else {
  45.     set data(pw:border) [frame $w.border]
  46.     set data(pw:pad)    [frame $w.border.pad]
  47.     set data(w:frame)   [frame $w.border.frame]
  48.     }
  49.  
  50.     if {$data(-labelside) != "none"} {
  51.     set data(w:label) [label $w.label -text $data(-label)]
  52.     }
  53.     tixLabelWidget:Pack $w
  54.  
  55.     tixCallMethod $w ConstructFramedWidget $data(w:frame)
  56. }
  57.  
  58. proc tixLabelWidget:ConstructFramedWidget {w frame} {
  59.     # Do nothing
  60. }
  61.  
  62. proc tixLabelWidget:Pack {w} {
  63.     upvar #0 $w data
  64.  
  65.     if [catch {tixLabelWidget:Pack-$data(-labelside) $w}] {
  66.     error "unknown -labelside option \"$data(-labelside)\""
  67.     }
  68. }
  69.  
  70. proc tixLabelWidget:Pack-acrosstop {w} {
  71.     upvar #0 $w data
  72.  
  73.     set labHalfHeight [expr [winfo reqheight $data(w:label)] / 2]
  74.     set padHeight [expr $labHalfHeight - [$data(pw:border) cget -bd]]
  75.     if {$padHeight < 0} {
  76.     set padHeight 0
  77.     }
  78.  
  79.     tixForm $data(w:label) -top 0 -left 4\
  80.     -padx [expr $data(-padx) +4] -pady $data(-pady)
  81.     tixForm $data(pw:border) -top $labHalfHeight -bottom -1 \
  82.     -left 0 -right -1 -padx $data(-padx) -pady $data(-pady)
  83.     tixForm $data(pw:pad) -left 0 -right -1 \
  84.     -top 0 -bottom $padHeight
  85.     tixForm $data(w:frame) -top $data(pw:pad) -bottom -1 \
  86.     -left 0 -right -1
  87. }
  88.  
  89. proc tixLabelWidget:Pack-top {w} {
  90.     upvar #0 $w data
  91.  
  92.     pack $data(w:label) -side top \
  93.     -padx $data(-padx) -pady $data(-pady) \
  94.     -fill x
  95.     pack $data(w:frame) -side top \
  96.     -padx $data(-padx) -pady $data(-pady) \
  97.     -expand yes -fill both
  98. }
  99.  
  100. proc tixLabelWidget:Pack-bottom {w} {
  101.     upvar #0 $w data
  102.  
  103.     pack $data(w:label) -side bottom \
  104.     -padx $data(-padx) -pady $data(-pady) \
  105.     -fill x
  106.     pack $data(w:frame) -side bottom \
  107.     -padx $data(-padx) -pady $data(-pady) \
  108.     -expand yes -fill both
  109. }
  110.  
  111. proc tixLabelWidget:Pack-left {w} {
  112.     upvar #0 $w data
  113.  
  114.     pack $data(w:label) -side left \
  115.     -padx $data(-padx) -pady $data(-pady) \
  116.     -fill y
  117.     pack $data(w:frame) -side left \
  118.     -padx $data(-padx) -pady $data(-pady) \
  119.     -expand yes -fill both
  120. }
  121.  
  122. proc tixLabelWidget:Pack-right {w} {
  123.     upvar #0 $w data
  124.  
  125.     pack $data(w:label) -side right \
  126.     -padx $data(-padx) -pady $data(-pady) \
  127.     -fill x
  128.     pack $data(w:frame) -side right \
  129.     -padx $data(-padx) -pady $data(-pady) \
  130.     -expand yes -fill both
  131. }
  132.  
  133. proc tixLabelWidget:Pack-none {w} {
  134.     upvar #0 $w data
  135.  
  136.     pack $data(w:frame)\
  137.     -padx $data(-padx) -pady $data(-pady) \
  138.     -expand yes -fill both
  139. }
  140.  
  141. #----------------------------------------------------------------------
  142. #                           CONFIG OPTIONS
  143. #----------------------------------------------------------------------
  144. proc tixLabelWidget:config-label {w value} {
  145.     upvar #0 $w data
  146.  
  147.     $data(w:label) config -text $value
  148.  
  149.     if {$data(-labelside) == "acrosstop"} {
  150.     tixLabelWidget:Pack-acrosstop $w
  151.     }
  152. }
  153.